home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of www.BestZips.com (Collector's Edition)
/
Best of WWW.BESTZIPS.COM Collector's Edition (JCSM Shareware) (JCS Marketing).ISO
/
tutorial
/
adatu311.zip
/
OPEN.ADA
< prev
next >
Wrap
Text File
|
1996-01-10
|
3KB
|
71 lines
-- OPEN.ADA Ver. 3.11 10-JAN-1996 Copyright 1988-1996 John J. Herro
--
-- SOFTWARE INNOVATIONS TECHNOLOGY http://members.aol.com/AdaTutor
-- 1083 MANDARIN DR NE ftp://members.aol.com/AdaTutor
-- PALM BAY FL 32905-4706
-- johnherro@aol.com
-- (407) 951-0233 john.herro%374-38-2@satlink.oau.org
--
-- Compile this before compiling ADA_TUTR.ADA, when using a PC with an Open
-- Ada compiler, now sold by D.C. Heath Co.
--
with Tty;
package Custom_IO is
type Color is (Black, Red, Green, Yellow, Blue, Magenta, Cyan, White);
Foregrnd_Color : Color := White; -- Default values in case
Backgrnd_Color : Color := Black; -- ADA-TUTR finds no User
Border_Color : Color := Black; -- File.
Fore_Color_Digit : Character := Character'Val(Color'Pos(Foregrnd_Color)+48);
Back_Color_Digit : Character := Character'Val(Color'Pos(Backgrnd_Color)+48);
Normal_Colors : String(1 .. 10) := ASCII.ESC & "[0;3" &
Fore_Color_Digit & ";4" & Back_Color_Digit & "m";
Clear_Scrn : constant String := ASCII.ESC & "[H" & ASCII.ESC &"[2J";
procedure Set_Border_Color (To : in Color);
procedure Get (Char : out Character);
procedure Put (Char : in Character) renames Tty.Put;
procedure Put (Str : in String) renames Tty.Put;
procedure Put_Line (Str : in String) renames Tty.Put_Line;
procedure Get_Line (Str : out String; Last : out Natural);
procedure New_Line;
end Custom_IO;
with Interrupt;
package body Custom_IO is
procedure Set_Border_Color(To : in Color) is
--
-- This procedure sets the border color on a PC by calling interrupt
-- 10 hex. Before the call, register AH is set to service number 0B hex,
-- BH is set to zero, and BL is set to an integer as shown in the
-- declaration of Color_Number below. Note that the integers in
-- Color_Number are bit reversed from the integers defining foreground
-- and background colors in ANSI escape sequences. Note also that some
-- color PCs don't have separate border colors.
--
Regis_Block : Interrupt.Registers;
Color_Number : constant array(Color) of Integer :=
(Black => 0, Red => 4, Green => 2, Yellow => 6,
Blue => 1, Magenta => 5, Cyan => 3, White => 7);
begin
Regis_Block.AX := 16#0B00#;
Regis_Block.BX := 16#0000# + COLOR_NUMBER(TO);
Interrupt.Vector(On => 16#10#, Register_Block => Regis_Block);
end Set_Border_Color;
procedure Get(Char : out Character) is
begin
Char := Tty.Get(No_Echo => True);
end Get;
procedure Get_Line(Str : out String; Last : out Natural) is
begin
Tty.Get(Str, Last);
New_Line;
end Get_Line;
procedure New_Line is
begin
Put_Line("");
end New_Line;
end Custom_IO;